home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / term / pc-win.el.z / pc-win.el
Encoding:
Text File  |  1998-05-21  |  7.6 KB  |  205 lines
  1. ;; pc-win.el -- setup support for `PC windows' (whatever that is).
  2.  
  3. ;; Copyright (C) 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Morten Welinder <terra@diku.dk>
  6. ;; Version: 1,00
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23. ;; ---------------------------------------------------------------------------
  24. (load "term/internal" nil t)
  25.  
  26. ;; Color translation -- doesn't really need to be fast
  27.  
  28. (defvar msdos-color-aliases
  29.   '(("purple"         . "magenta")
  30.     ("firebrick"      . "red")        ; ?
  31.     ("pink"           . "lightred")
  32.     ("royalblue"      . "blue")
  33.     ("cadetblue"      . "blue")
  34.     ("forestgreen"    . "green")
  35.     ("darkolivegreen" . "green")
  36.     ("darkgoldenrod"  . "brown")
  37.     ("goldenrod"      . "yellow")
  38.     ("grey40"         . "darkgray")
  39.     ("rosybrown"      . "brown")
  40.     ("blue"          .    "lightblue")  ;; from here: for Enriched Text
  41.     ("darkslategray"  .    "darkgray")
  42.     ("orange"          .    "brown")
  43.     ("light blue"     .    "lightblue")  ;; from here: for cpp-highlight
  44.     ("light cyan"     .    "lightcyan")
  45.     ("light yellow"   .    "yellow")
  46.     ("light pink"     .    "lightred")
  47.     ("pale green"     .    "lightgreen")
  48.     ("beige"          .    "brown")
  49.     ("medium purple"  .    "magenta")
  50.     ("turquoise"      . "lightgreen")
  51.     ("violet"          .    "magenta"))
  52.   "List of alternate names for colors.")
  53.  
  54. (defun msdos-color-translate (name)
  55.   (setq name (downcase name))
  56.   (let* ((len (length name))
  57.      (val (cdr (assoc name
  58.              '(("black" . 0)
  59.                ("blue" . 1)
  60.                ("green" . 2)
  61.                ("cyan" . 3)
  62.                ("red" . 4)
  63.                ("magenta" . 5)
  64.                ("brown" . 6)
  65.                ("lightgray" . 7) ("light gray" . 7)
  66.                ("darkgray" . 8) ("dark gray" . 8)
  67.                ("lightblue" . 9)
  68.                ("lightgreen" . 10)
  69.                ("lightcyan" . 11)
  70.                ("lightred" . 12)
  71.                ("lightmagenta" . 13)
  72.                ("yellow" . 14)
  73.                ("white" . 15)))))
  74.      (try))
  75.     (or val
  76.     (and (setq try (cdr (assoc name msdos-color-aliases)))
  77.          (msdos-color-translate try))
  78.     (and (> len 5)
  79.          (string= "light" (substring name 0 4))
  80.          (setq try (msdos-color-translate (substring name 5)))
  81.          (logior try 8))
  82.     (and (> len 6)
  83.          (string= "light " (substring name 0 5))
  84.          (setq try (msdos-color-translate (substring name 6)))
  85.          (logior try 8))
  86.     (and (> len 4)
  87.          (string= "dark" (substring name 0 3))
  88.          (msdos-color-translate (substring name 4)))
  89.     (and (> len 5)
  90.          (string= "dark " (substring name 0 4))
  91.          (msdos-color-translate (substring name 5))))))
  92. ;; ---------------------------------------------------------------------------
  93. ;; We want to delay setting frame parameters until the faces are setup
  94. (defvar default-frame-alist nil)
  95.  
  96. (defun msdos-face-setup ()
  97.   (modify-frame-parameters (selected-frame) default-frame-alist)
  98.  
  99.   (set-face-foreground 'bold "yellow")
  100.   (set-face-foreground 'italic "red")
  101.   (set-face-foreground 'bold-italic "lightred")
  102.   (set-face-foreground 'underline "white")
  103.   (set-face-background 'region "green")
  104.  
  105.   (make-face 'msdos-menu-active-face)
  106.   (make-face 'msdos-menu-passive-face)
  107.   (make-face 'msdos-menu-select-face)
  108.   (set-face-foreground 'msdos-menu-active-face "white")
  109.   (set-face-foreground 'msdos-menu-passive-face "lightgray")
  110.   (set-face-background 'msdos-menu-active-face "blue")
  111.   (set-face-background 'msdos-menu-passive-face "blue")
  112.   (set-face-background 'msdos-menu-select-face "red"))
  113.  
  114. ;; We have only one font, so...
  115. (add-hook 'before-init-hook 'msdos-face-setup)
  116. ;; ---------------------------------------------------------------------------
  117. ;; More or less useful immitations of certain X-functions.  A lot of the
  118. ;; values returned are questionable, but usually only the form of the
  119. ;; returned value matters.  Also, by the way, recall that `ignore' is
  120. ;; a useful function for returning 'nil regardless of argument.
  121.  
  122. ;; From src/xfns.c
  123. (defun x-display-color-p (&optional display) 't)
  124. (fset 'focus-frame 'ignore)
  125. (fset 'unfocus-frame 'ignore)
  126. (defun x-list-fonts (pattern &optional face frame) (list "default"))
  127. (defun x-color-defined-p (color) (numberp (msdos-color-translate color)))
  128. (defun x-display-pixel-width (&optional frame) (* 8 (frame-width frame)))
  129. (defun x-display-pixel-height (&optional frame) (* 8 (frame-height frame)))
  130. (defun x-display-planes (&optional frame) 4) ; 3 for background, actually
  131. (defun x-display-color-cells (&optional frame) 16) ; ???
  132. (defun x-server-max-request-size (&optional frame) 1000000) ; ???
  133. (defun x-server-vendor (&optional frame) t "GNU")
  134. (defun x-server-version (&optional frame) '(1 0 0))
  135. (defun x-display-screens (&optional frame) 1)
  136. (defun x-display-mm-height (&optional frame) 200) ; Guess the size of my
  137. (defun x-display-mm-width (&optional frame) 253)  ; monitor, MW...
  138. (defun x-display-backing-store (&optional frame) 'not-useful)
  139. (defun x-display-visual-class (&optional frame) 'static-color)
  140. (fset 'x-display-save-under 'ignore)
  141. (fset 'x-get-resource 'ignore)
  142.  
  143. ;; From lisp/term/x-win.el
  144. (setq x-display-name "pc")
  145. (setq split-window-keep-point t)
  146.  
  147. ;; From lisp/select.el
  148. (defun x-get-selection (&rest rest) "")
  149. (fset 'x-set-selection 'ignore)
  150.  
  151. ;; From lisp/faces.el: we only have one font, so always return
  152. ;; it, no matter which variety they've asked for.
  153. (defun x-frob-font-slant (font which)
  154.   font)
  155.  
  156. ;; From lisp/frame.el
  157. (fset 'set-default-font 'ignore)
  158. (fset 'set-mouse-color 'ignore)        ; We cannot, I think.
  159. (fset 'set-cursor-color 'ignore)    ; Hardware determined by char under.
  160. (fset 'set-border-color 'ignore)    ; Not useful.
  161. (fset 'auto-raise-mode 'ignore)
  162. (fset 'auto-lower-mode 'ignore)
  163. (defun set-background-color (color-name)
  164.   "Set the background color of the selected frame to COLOR.
  165. When called interactively, prompt for the name of the color to use."
  166.   (interactive "sColor: ")
  167.   (modify-frame-parameters (selected-frame)
  168.                (list (cons 'background-color color-name))))
  169. (defun set-foreground-color (color-name)
  170.   "Set the foreground color of the selected frame to COLOR.
  171. When called interactively, prompt for the name of the color to use."
  172.   (interactive "sColor: ")
  173.   (modify-frame-parameters (selected-frame)
  174.                (list (cons 'foreground-color color-name))))
  175. ;; ---------------------------------------------------------------------------
  176. ;; Handle the X-like command line parameters "-fg" and "-bg"
  177. (defun msdos-handle-args (args)
  178.   (let ((rest nil))
  179.     (while args
  180.       (let ((this (car args)))
  181.     (setq args (cdr args))
  182.     (cond ((or (string= this "-fg") (string= this "-foreground"))
  183.            (if args
  184.            (setq default-frame-alist
  185.              (cons (cons 'foreground-color (car args))
  186.                    default-frame-alist)
  187.              args (cdr args))))
  188.           ((or (string= this "-bg") (string= this "-background"))
  189.            (if args
  190.            (setq default-frame-alist
  191.              (cons (cons 'background-color (car args))
  192.                    default-frame-alist)
  193.              args (cdr args))))
  194.           (t (setq rest (cons this rest))))))
  195.     (nreverse rest)))
  196.  
  197. (setq command-line-args (msdos-handle-args command-line-args))
  198. ;; ---------------------------------------------------------------------------
  199. ;; XEmacs always has faces
  200. ;;(require 'faces)
  201. (if (msdos-mouse-p)
  202.     (progn
  203.       (require 'menu-bar)
  204.       (menu-bar-mode t)))
  205.